home *** CD-ROM | disk | FTP | other *** search
/ Cobra Utilities for Doom & Doom II / Cobra Utilities For Doom & Doom II - Disc 2.iso / files / program / dhtk100 / walls.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1994-05-26  |  6.4 KB  |  217 lines
  1. {****************************************************************************
  2. *                      The DOOM Hacker's Tool Kit                           *
  3. *****************************************************************************
  4. * Unit   : OBJCACHE                                                         *
  5. * Purpose: Object Cache Memory Allocation Deamon                            *
  6. * Date:    4/28/94                                                          *
  7. * Author:  Joshua Jackson        Internet: joshjackson@delphi.com           *
  8. ****************************************************************************}
  9.  
  10. {$O+,F+}
  11. unit Walls;
  12.  
  13. interface
  14.  
  15. uses    Wad,WadDecl,Things,ObjCache;
  16.  
  17. const    MaxPatches = 128;
  18.  
  19. type  PWallTexture=^TWallTexture;
  20.         TWallTexture=object
  21.           Name        :objnamestr;
  22.          Patches  :word;
  23.          Image        :^BA;
  24.          Width        :word;
  25.          Height    :word;
  26.             Constructor Init(WDir:PWadDirectory;TextName:ObjNameStr);
  27.             Procedure Draw(Scale,XOfs,YOfs:integer);
  28.             Destructor Done;
  29.         end;
  30.  
  31. implementation
  32.  
  33. uses     crt,graph;
  34.  
  35. Constructor TWallTexture.Init(WDir:PWadDirectory;TextName:ObjNameStr);
  36.  
  37.     type     IA=array[1..16000] of longint;
  38.              POffsetList=^TOffsetList;
  39.             TOffsetList=array[0..320] of longint;
  40.             SpDim=record
  41.                 xsize    :integer;
  42.                 ysize    :integer;
  43.                 xofs    :integer;
  44.                 yofs    :integer;
  45.             end;
  46.          PatchDesc=record
  47.              xofs    :integer;
  48.             yofs    :integer;
  49.             PNum    :word;
  50.                 junk    :longint;
  51.          end;
  52.          PatchList=array[1..MaxPatches] of PatchDesc;
  53.  
  54.     var    l,t:word;
  55.            C1,ObjCache:PObjectCache;
  56.          NumTex:Longint;
  57.          Offsets:^IA;
  58.             TexOfs,TexDirStart:longint;
  59.          TempName:ObjNameStr;
  60.            sd:SpDim;
  61.             x,y:integer;
  62.             srow,rowlen:byte;
  63.             spSize:word;
  64.             pixel:byte;
  65.             PatchOfs:POffsetList;
  66.          PList:^PatchList;
  67.             RowBuff:array[1..320] of byte;
  68.  
  69.     begin
  70.       for t:=1 to length(TextName) do begin
  71.           if TextName[t] = #32 then
  72.                 TextName[t]:=#0;
  73.          TextName[t]:=UpCase(TextName[t]);
  74.       end;
  75.        TexOfs:=0;
  76.         l:=WDir^.FindObject('TEXTURE1');
  77.         if l=0 then begin
  78.             TextMode(co80);
  79.             writeln('TWallTexture_Init: Could not locate TEXTURE1.');
  80.             WDir^.Done;
  81.             halt;
  82.         end;
  83.       C1:=New(PObjectCache, Init(WDir, WDir^.FindObject('TEXTURE1')));
  84.       TexDirStart:=WDir^.DirEntry^[WDir^.FindObject('TEXTURE1')].ObjStart;
  85.       c1^.CacheRead(NumTex,4);
  86.       GetMem(Offsets, NumTex * 4);
  87.       c1^.CacheRead(Offsets^, NumTex * 4);
  88.       for l:=1 to NumTex do begin
  89.           c1^.SetPos(Offsets^[l]);
  90.          c1^.CacheRead(TempName[1], 8);
  91.          if TempName = TextName then begin
  92.              Name:=TempName;
  93.              TexOfs:=Offsets^[l] + TexDirStart;
  94.                 c1^.IncPos(4);
  95.             c1^.CacheRead(Width, 2);
  96.             c1^.CacheRead(Height, 2);
  97.             c1^.IncPos(4);
  98.             c1^.CacheRead(Patches, 2);
  99.              break;
  100.          end;
  101.       end;
  102.       FreeMem(Offsets, NumTex * 4);
  103.       Dispose(c1, done);
  104.       if TexOfs=0 then begin
  105.           C1:=New(PObjectCache, Init(WDir, WDir^.FindObject('TEXTURE2')));
  106.           TexDirStart:=WDir^.DirEntry^[WDir^.FindObject('TEXTURE2')].ObjStart;
  107.           c1^.CacheRead(NumTex,4);
  108.           GetMem(Offsets, NumTex * 4);
  109.           c1^.CacheRead(Offsets^, NumTex * 4);
  110.           for l:=1 to NumTex do begin
  111.               c1^.SetPos(Offsets^[l]);
  112.              c1^.CacheRead(TempName[1], 8);
  113.              if TempName = TextName then begin
  114.                  Name:=TempName;
  115.                  TexOfs:=Offsets^[l] + TexDirStart;
  116.                     c1^.IncPos(4);
  117.                 c1^.CacheRead(Width, 2);
  118.                 c1^.CacheRead(Height, 2);
  119.                 c1^.IncPos(4);
  120.                 c1^.CacheRead(Patches, 2);
  121.                  break;
  122.              end;
  123.           end;
  124.           FreeMem(Offsets, NumTex * 4);
  125.          Dispose(c1, done);
  126.       end;
  127.       if TexOfs = 0 then begin
  128.          Dispose(WDir, Done);
  129.          writeln('TWallTexture_Init: Texture name: ',TextName,' Not Found');
  130.          halt(1);
  131.       end;
  132.       GetMem(Image, Width * Height);    {Allocate Memory For Texture}
  133.         fillchar(Image^,Width * Height,#0);
  134.       c1:=New(PObjectCache, Init(WDir, WDir^.FindObject('PNAMES  ')));
  135.       GetMem(PList, Patches * 10);
  136.       Seek(WDir^.WadFile, TexOfs + 22);
  137.       BlockRead(WDir^.WadFile, PList^, Patches * 10);
  138.       c1^.IncPos(2);
  139.       for t:=1 to Patches do begin
  140.           c1^.SetPos(((PList^[t].PNum ) * 8) + 4);
  141.          c1^.CacheRead(TempName, 8);
  142.           l:=WDir^.FindObject(TempName);
  143.             if l=0 then begin
  144.                 TextMode(co80);
  145.                 writeln('WallTexure_Init: Could not locate patch ID: ',TempName);
  146.                 WDir^.Done;
  147.                 halt;
  148.             end;
  149.             seek(WDir^.WadFile,WDir^.DirEntry^[l].ObjStart);
  150.             BlockRead(WDir^.WadFile,sd.XSize,8);
  151.             spSize:=sd.xSize * sd.ySize;                    {Calc Total Patch Image Size}
  152.             if spSize > 64000 then begin                    {Error Check}
  153.                 TextMode(co80);
  154.                 writeln('WallTexture_Init: Invalid Patch Image Size');
  155.                 WDir^.Done;
  156.                 halt;
  157.             end;
  158.             GetMem(PatchOfs, sd.xSize * 4);        {Allocate Row Offset Buffer}
  159.             ObjCache:=New(PObjectCache, Init(WDir, l));
  160.             ObjCache^.IncPos(8);
  161.             ObjCache^.CacheRead(PatchOfs^,sd.xSize * 4);
  162.             for x:= 0 to sd.xsize - 1 do begin   {-1}
  163.                 ObjCache^.SetPos(PatchOfs^[x]);
  164.                 ObjCache^.CacheRead(SRow,1);
  165.                 while srow<>255 do begin
  166.                     ObjCache^.CacheRead(RowLen,1);
  167.                     ObjCache^.CacheRead(RowBuff, RowLen+2);
  168.                     for y:=0 to rowlen  do begin {-1}
  169.                         pixel:=RowBuff[y+2];
  170.                         l:=(x + PList^[t].xofs) + (srow + y + PList^[t].yofs) * Width;
  171.                         if l < (Width * Height) then
  172.                             Image^[l]:=Pixel;
  173.                     end; {for y}
  174.                     ObjCache^.CacheRead(SRow,1);
  175.                 end; {while}
  176.             end; {for x}
  177.             Dispose(ObjCache, Done);
  178.             freemem(PatchOfs, sd.xsize * 4);
  179.         end;
  180.       Dispose(c1, Done);
  181.       FreeMem(PList, Patches * 10);
  182.    end;
  183.  
  184. Procedure TWallTexture.Draw(Scale,XOfs,YOfs:integer);
  185.  
  186.     var     y1,y2,x1,x2:integer;
  187.             xPix,yPix,oxpix,oypix:integer;
  188.             xSize:integer;
  189.  
  190.     begin
  191.         oxpix:=0;
  192.         oypix:=0;
  193.         XSize:=Width;
  194.         for y1:=0 to (Height - 1) do begin
  195.             yPix:=(y1 * Scale) div 100;
  196.             for y2:=oypix to ypix do begin
  197.             oxpix:=0;
  198.                 for x1:=0 to (Width - 1) do begin
  199.                     xPix:=x1 * Scale div 100;
  200.                     for x2:=oxpix to xpix do begin
  201.                         PutPixel(x2+Xofs,y2+YOfs,Image^[(y1*xSize)+x1]);
  202.                     end;
  203.                     oxpix:=xpix+1;
  204.                 end;
  205.             end;
  206.             oypix:=ypix + 1;
  207.         end;
  208.     end;
  209.  
  210. Destructor TWallTexture.Done;
  211.  
  212.     begin
  213.       FreeMem(Image, Width * Height);
  214.     end;
  215.  
  216. end.
  217.